home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
EAGUI
/
TextField.mod
< prev
Wrap
Text File
|
1995-06-29
|
5KB
|
160 lines
(*************************************************************************
$RCSfile: TextField.mod $
Description: Port of the EAGUI TextField.c
Ported by: fjc (Frank Copeland)
$Revision: 1.2 $
$Author: fjc $
$Date: 1995/06/04 23:19:58 $
Oberon-A Port Copyright © 1995, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
**************************************************************************
* *
* TextField.c - A simple example source that demonstrates how to *
* implement custom images in EAGUI. *
* *
*************************************************************************)
<* STANDARD- *>
<*$ StackChk- *>
<*$ LongVars+ *>
MODULE TextField;
IMPORT
SYS := SYSTEM, Kernel, s := Sets, e := Exec, u := Utility,
gfx := Graphics, i := Intuition, ea := EAGUI;
CONST
(* Alternative alignment flags. If these aren't specified, the default is
* to center the textfield both horizontally and vertically.
*)
CITF_ALIGNLEFT * = 0;
CITF_ALIGNRIGHT * = 1;
CITF_ALIGNTOP * = 2;
CITF_ALIGNBOTTOM * = 3;
TYPE
(* Information that is needed by this object, but that isn't maintained
* by EAGUI itself.
*)
ci_TextFieldPtr * = POINTER [2] TO ci_TextField;
ci_TextField * = RECORD [2]
tf_string_ptr * : e.LSTRPTR; (* string that is displayed *)
tf_textattr_ptr * : gfx.TextAttrPtr; (* font that is used *)
tf_flags * : s.SET32; (* different flags *)
tf_frontpen * : e.UBYTE; (* front pen to use *)
END;
VAR
itext : i.IntuiText;
(*************************************************************************
* *
* MinSize Method *
* *
*************************************************************************)
PROCEDURE MinSize*
( hook_ptr : u.HookPtr;
obj_ptr : ea.OPTR;
msg_ptr : e.APTR )
: e.ULONG;
VAR
minwidth, minheight, ignore : LONGINT;
tf_ptr : ci_TextFieldPtr;
BEGIN (* MinSize *)
(* get a pointer to our structure, and check if we actually got it *)
tf_ptr := SYS.VAL (ci_TextFieldPtr, ea.GetAttr (obj_ptr, ea.UserData));
IF tf_ptr # NIL THEN
(* now, we use the library to determine the dimensions of the string *)
minwidth :=
ea.TextLengthPtr (tf_ptr.tf_textattr_ptr, tf_ptr.tf_string_ptr, 0X);
minheight :=
ea.TextHeightPtr (tf_ptr.tf_textattr_ptr);
(* and finally, we set these values *)
ignore := ea.SetAttr (obj_ptr, ea.MinWidth, minwidth);
ignore := ea.SetAttr (obj_ptr, ea.MinHeight, minheight);
END;
(* we always return success *)
RETURN 0
END MinSize;
(*************************************************************************
* *
* Render Method *
* *
*************************************************************************)
PROCEDURE Render*
( hook_ptr : u.HookPtr;
obj_ptr : ea.OPTR;
rm_ptr : ea.RenderMessagePtr )
: e.ULONG;
VAR
tf_ptr : ci_TextFieldPtr;
minwidth, minheight, width, height, left, top, ignore : e.ULONG;
BEGIN (* Render *)
(* get a pointer to our structure, and check if we actually got it *)
tf_ptr := SYS.VAL (ci_TextFieldPtr, ea.GetAttr (obj_ptr, ea.UserData));
IF tf_ptr # NIL THEN
(* get sizes of the object *)
ignore := ea.GetAttrs ( obj_ptr,
ea.MinWidth, SYS.ADR (minwidth),
ea.MinHeight, SYS.ADR (minheight),
ea.Width, SYS.ADR (width),
ea.Height, SYS.ADR (height),
u.done );
(* get offsets of object relative to root (window) *)
left := ea.GetObjectLeft (rm_ptr.root_ptr, obj_ptr);
top := ea.GetObjectTop (rm_ptr.root_ptr, obj_ptr);
(* now align the object *)
IF (CITF_ALIGNRIGHT IN tf_ptr.tf_flags) THEN
INC (left, (width - minwidth));
ELSIF (~(CITF_ALIGNLEFT IN tf_ptr.tf_flags)) THEN
INC (left, (width - minwidth) DIV 2);
END;
IF (CITF_ALIGNBOTTOM IN tf_ptr.tf_flags) THEN
INC (top, (height - minheight))
ELSIF (~(CITF_ALIGNTOP IN tf_ptr.tf_flags)) THEN
INC (top, (height - minheight) DIV 2);
END;
(* and finally render it *)
itext.iTextFont := tf_ptr.tf_textattr_ptr;
itext.iText := tf_ptr.tf_string_ptr;
itext.frontPen := tf_ptr.tf_frontpen;
i.PrintIText (rm_ptr.rastport_ptr, itext, left, top);
END;
(* return success *)
RETURN 0
END Render;
PROCEDURE Init;
BEGIN (* Init *)
(* Assuming uninitialised fields are zeroed... *)
itext.frontPen := 1; itext.drawMode := gfx.jam1
END Init;
BEGIN
Init
END TextField.